home *** CD-ROM | disk | FTP | other *** search
- {
- ***
-
- SCREENRT.PAS
- Screen-related Routines
- (C)Copyright Gerard Paul Java 1996
-
- Unit Source File
-
- Licensed material - program property of Fencer Software
-
-
- This unit contains general routines related to the screen. It contains
- a box-drawing routine, the screen save/restore routines, a function that
- returns a string of a particular character repeated, cursor-manipulation
- routines, and the routines that save, set, and restore the screen mode.
- It also contains a routine that sets both foreground and background colors
- at once.
-
- ***
-
- }
-
-
- {$A+,B-,F-,I-,N-,R-,S-,V-}
-
- unit ScreenRt;
-
- interface
-
- type
- OrigWindowType = object
- Min: word;
- Max: word;
- procedure Save;
- procedure Restore;
- end;
-
- ReptStrLenRange = 1..80;
-
- Str80 = string[80];
- Str78 = string[78];
-
- ScreenBufferType = array[1..2000] of word; { Buffer for screen saves/restores. }
-
- const
- SingleLine = False;
- DoubleLine = True;
-
- var
- BoxAttr : byte;
- TextNormAttr: byte;
- TextHighAttr: byte;
-
- function StringOf(Character: char;Count: ReptStrLenRange): Str80;
- procedure DrawBox(X1,Y1,X2,Y2: byte;Style: boolean);
- procedure DivideBox(Col,Top,Bottom: byte);
- procedure SetCursor(ScanLines: word);
- inline($B4/$01/ { MOV AH,1 }
- $59/ { POP CX ;ScanLines were pushed. }
- $CD/$10); { INT $10 }
- procedure PutChar(X,Y,Character: byte);
- procedure SetTSSRValues;
- procedure SaveScreen(var ScreenBuffer: ScreenBufferType);
- procedure RestoreScreen(var ScreenBuffer: ScreenBufferType);
-
- implementation
- uses
- Crt;
-
- const
- Space = ' ';
- Null = '';
-
-
- {---------------------------------------------------------------------------
- StringOf: Returns a string consisting of Count occurences of a character.
- ---------------------------------------------------------------------------}
-
- function StringOf(Character: char;Count: ReptStrLenRange): Str80; external;
- {$L STRINGOF.OBJ}
-
-
- {---------------------------------------------------------------------------
- Box: Creates a box on the screen. The box has spaces within it, so any
- characters on the screen within the boundaries of the box are erased. The
- high-level ASCII characters ╔ (201), ╗ (187), ╚ (200), ╝ (188), ═ (205),
- and ║ (186) are used to create the box.
- ---------------------------------------------------------------------------}
-
- procedure DrawBox(X1,Y1,X2,Y2: byte;Style: boolean);
- var
- ULeftChar,
- LLeftChar,
- URightChar,
- LRightChar,
-
- HorBarChar,
- VerBarChar: char;
-
- Wid : byte;
-
- Row : byte;
-
- HorzBar : Str78;
- InSpaces : Str78;
-
- begin { proc }
- case Style of
- SingleLine: begin
- ULeftChar := #218;
- LLeftChar := #192;
- URightChar := #191;
- LRightChar := #217;
-
- HorBarChar := #196;
- VerBarChar := #179;
- end;
- DoubleLine: begin
- ULeftChar := #201;
- LLeftChar := #200;
- URightChar := #187;
- LRightChar := #188;
-
- HorBarChar := #205;
- VerBarChar := #186;
- end;
- end;
- Wid := X2-X1-1; { Calculate box width. }
-
- HorzBar := StringOf(HorBarChar,Wid);
- InSpaces := StringOf(Space,Wid);
-
- GotoXY(X1,Y1);Write(ULeftChar,HorzBar,URightChar);
-
- for Row := Y1+1 to Y2-1 do
- begin { for }
- GotoXY(X1,Row);
- Write(VerBarChar,InSpaces,VerBarChar);
- end; { for }
-
- GotoXY(X1,Y2);Write(LLeftChar,HorzBar,LRightChar);
- end; { proc }
-
- procedure DivideBox(Col,Top,Bottom: byte);
- var
- Ctr: byte;
-
- begin
- GotoXY(Col,Top);Write(#209);
- GotoXY(Col,Bottom);Write(#207);
-
- for Ctr := Top+1 to Bottom-1 do
- begin
- GotoXY(Col,Ctr);Write(#179);
- end;
- end;
-
- procedure OrigWindowType.Save;
- begin
- Min := WindMin;
- Max := WindMax;
- end;
-
- procedure OrigWindowType.Restore;
- begin
- WindMin := Min;
- WindMax := Max;
- end;
-
- {---------------------------------------------------------------------------
- These are the external screen save/restore routines. SetTSSRValues
- determines the video configuration and sets the proper values for the
- screen segment and other variables to work with. SaveScreen saves the
- screen in a 2000-word array variable, and RestoreScreen copies the contents
- of the array variable back to the screen.
- ---------------------------------------------------------------------------}
-
- {$L PUTCHAR.OBJ}
-
- procedure PutChar; external;
-
- {$L TSSR.OBJ} { Link in screen save/restore routines. }
-
- procedure SetTSSRValues; external;
- procedure SaveScreen; external;
- procedure RestoreScreen; external;
-
- end.
-